home *** CD-ROM | disk | FTP | other *** search
/ MacTech 1 to 12 / MacTech-vol-1-12.toast / Source / MacTech® Magazine / Volume 09 - 1993 / 09.02 Feb 93 / Jörg's Folder / Modules.4th < prev    next >
Encoding:
Text File  |  1992-10-30  |  6.1 KB  |  265 lines  |  [TEXT/EDIT]
  1. ( ===== Extra Name Space Words ===== )
  2.  
  3. ( This file defines words used to extend the Names space.  This is used
  4.   primarily for CONSTANT definitions for Macintosh symbols.  This should
  5.   not be used for variable definitions.)
  6.  
  7. push.VOCAB.state
  8. ONLY FORTH 
  9. ALSO DEVELOPMENT DEFINITIONS
  10. ALSO ASSEMBLER
  11.  
  12. (
  13.               |------------------------------------|
  14.               |                                    |
  15.  ---------    |   ---------        ----------      |
  16.  |  ptr  | ---|   | handle | <--   | handle | <--- |
  17.  ---------        ----------   |   ----------
  18.                   |   0    |   --- |  ptr   |
  19.                   ----------       ----------
  20. )
  21.  
  22. 0 Module.list !
  23.  
  24. ( Insert.Name.Space allocates an 8-byte array that holds three variables:
  25.   The first variable is a handle to the inserted name space.  
  26.   The second variable is used as a forward linked list to point to the 
  27.   next handle.  Used as follows:
  28.  
  29.     4800 Insert.MODULE _FSEQU_ 
  30. )
  31.  
  32. CODE get.A5
  33.     MOVE.L    A5,-(A6)
  34.     RTS
  35. END-CODE MACH
  36.  
  37. CODE find.Next    ( lfa -- lfa vocab.id )
  38.     MOVE.L    (A6),A1            \ put current LFA in reg
  39.     MOVE.L    $40(A4),D3        \ CONTEXT
  40.  
  41. @c
  42.     TST.L    D3
  43.     BPL.S    @start.looking
  44.  
  45. @not.found
  46.     MOVEQ.L    #0,D0
  47.     MOVE.L    D0,(A6)
  48.     MOVE.L    D0,-(A6)
  49.     RTS
  50.  
  51. @start.looking
  52.     MOVEA.L    $-532(A5),A0    \ dictionary ptr
  53.     MOVE.L    D3,D2            \ copy CONTEXT
  54.     ANDI.L    #$F,D2            \ mask out for low dict
  55.     ASL.L    #$3,D2            \ multiply by 8
  56.     ADDA.L    $32(A0,D2.W),A0    \ get LAST for this vocab
  57.     CMPI.B    #$F,D3            \ does this dict vocab exist
  58.     BEQ.S    @not.found
  59.  
  60.     TST.L    D3                \ have we run out of vocabs
  61.     BEQ.S    @look.this.vocab
  62.  
  63.     LSR.L    #$4,D3            \ shift the next vocab
  64.     BNE.S    @check.LAST
  65.  
  66. @look.this.vocab
  67.     SUBQ.L    #$1,D3
  68.  
  69. @check.LAST
  70.     CMP.L    A0,A1            \ is the LAST in this vocab same as passed in
  71.     BNE.S    @e                \ branch if not so
  72.  
  73.     MOVEQ.L    #0,D0
  74.     MOVEA.L    D0,A0
  75.     BEQ.S    @we.found.it
  76.  
  77. @e
  78.     TST.L    (A0)            \ test lfa of word in vocab
  79.     BEQ.S    @c
  80.  
  81.     MOVE.L    A0,D0            \ addr of lfa
  82.     SUB.L    (A0),D0            \ addr of previous word
  83.     CMP.L    A1,D0            \ is it equal to the word we are looking for
  84.     BEQ.S    @we.found.it
  85.  
  86.     SUBA.L    (A0),A0            \ get next word
  87.     BRA.S    @e
  88.  
  89. @we.found.it
  90.     MOVE.L    A0,(A6)
  91.     MOVE.L    D2,-(A6)
  92.     RTS
  93. END-CODE
  94.  
  95. : MODULE.VAR
  96.     { | sfa -- }
  97.     CREATE -4 ALLOT LAST link>seg -> sfa
  98.     1 sfa W!
  99.     $41FA sfa 2+ W!
  100.     6 sfa 4+ W!
  101.     $2D08 sfa 6 + W!
  102.     $4E75 sfa 8 + W!
  103.     14 NP +!
  104.     ;
  105.  
  106. : Insert.MODULE
  107.     { names.size | name.handle names.var -- result }
  108.  
  109.     names.size CALL NewHandle    ( -- handle result )
  110.     0=
  111.     IF
  112.         ( allocation was successful )
  113.         -> name.handle
  114.         name.handle CALL MoveHHi DROP
  115.         name.handle CALL HLock DROP
  116.         ( store the pre-module NP in the module header )
  117.         NP @ name.handle @ !
  118.         ( set NP to point to 8 bytes into the module )
  119.         name.handle @ CALL StripAddress 8 + NP !
  120.  
  121.         MODULE.VAR        ( now the new names record is defined )
  122.         ( get the address of the module record )
  123.         LAST LINK>BODY EXECUTE -> names.var
  124.         name.handle names.var !    ( store the handle )
  125.  
  126.         ( now link to the list )
  127.         Module.list @ 0=
  128.         IF
  129.             names.var Module.list !
  130.             0 names.var 4+ !
  131.         ELSE
  132.             ( link to the tail of the list )
  133.             Module.list @                ( get ptr to end )
  134.             names.var Module.list !        ( end now is names.var )
  135.             names.var 4 + !                ( names.var points to previous end )
  136.         THEN
  137.     ELSE
  138.         DROP ( the handle )
  139.         -1 ABORT" ABORT - Memory Allocation failed for inserted Name Space."
  140.     THEN
  141.     ;
  142.  
  143. : restore.Name.Space
  144.     ( Used in the form:  _SYSEQU_ restore.Name.Space
  145.       where _SYSEQU_ was a name created by Insert.Name.Space. )
  146.  
  147.     ( store the lfa of the LAST word in this module in the module header )
  148.     DUP 
  149.     LAST SWAP @ @ 4+ !    ( store the last lfa in the module )
  150.     @ ( the handle from the module record )
  151.     @ ( the pointer from the handle )
  152.     @ ( the original NP from the name module )
  153.     NP !
  154.     ;
  155.  
  156. : forget.MODULE
  157.     ( used in the form:  _SYSEQU_ forget.MODULE )
  158.     { module.var | module.var.lfa next.lfa vocab.ID -- }
  159.  
  160.     module.var @ @ CALL StripAddress
  161.     8 + -> module.var.lfa 
  162.  
  163.     ( get the lfa of the last word in the module )
  164.     module.var.lfa  4- @      -> next.lfa
  165.  
  166.     next.lfa find.NEXT -> vocab.ID -> next.lfa
  167.     next.lfa
  168.     IF
  169.         next.lfa                    ( addr of 1st lfa after module )
  170.         module.var.lfa DUP @ -        ( addr of 1st lfa before module )
  171.         -                            ( create offset )
  172.         next.lfa !                    ( store in post-module lfa )
  173.  
  174.     ELSE
  175.         ( the lfa is zero, so the last word defined in this
  176.           vocabulary is the last word of the module )
  177.         module.var.lfa DUP @ -        ( addr of 1st lfa before module )
  178.         MOVE.L    $-532(A5),-(A6)        \ dict ptr
  179.         -                            ( create offset from start of dict )
  180.  
  181.         ( store this offset in the LAST variable for this vocabulary )
  182.         vocab.ID
  183.         MOVE.L    $-532(A5),A0        \ TEXT1 ptr
  184.         MOVE.L    (A6)+,D2            \ partial offset to LAST for this vocab
  185.         LEA        $32(A0,D2.W),A0        \ get addr of LAST for this vocab
  186.         MOVE.L    (A6)+,(A0)            \ store the new LAST for this vocab
  187.  
  188.         ( also update LAST and NP if needed )
  189.         LAST module.var.lfa  4- @ =
  190.         IF
  191.             module.var.lfa DUP @ -        ( addr of 1st lfa before module )
  192.             MOVE.L    (A6)+,$-1E0(A5)        ( update LAST )
  193.             module.var.lfa 8 - @ NP !    ( update NP to original setting )
  194.         THEN
  195.     THEN
  196.  
  197.     ( now we have to remove this module from the module linked list )
  198.     Module.list @ module.var =
  199.     IF
  200.         ( the module is the tail )
  201.         module.var 4+ @ Module.list !
  202.     ELSE
  203.         ( the module is either the middle or head )
  204.         Module.list @     ( get the pointer to the last )
  205.         BEGIN
  206.             DUP 4+ @ module.var = NOT ( -- next.ptr flag )
  207.         WHILE
  208.             4+ @
  209.         REPEAT
  210.         ( -- next.ptr )
  211.         module.var 4+ @ ( -- next.ptr prev.ptr )
  212.         SWAP 4+ !
  213.     THEN
  214.  
  215.     module.var @ CALL HUnlock DROP
  216.     module.var @ CALL DisposHandle DROP
  217.     HASHFORGET
  218.     ;
  219.  
  220. ( We need to redefine EMPTY so the handles can be de-allocated.)
  221.  
  222. push.VOCAB.state
  223. ONLY MAC 
  224. ALSO ASSEMBLER
  225. ALSO FORTH DEFINITIONS 
  226. ALSO DEVELOPMENT
  227.  
  228. CODE EMPTY
  229.     MOVEQ.L    #0,D3
  230.     MOVE.L    Module.list,D0        \ get pointer to namelist tail
  231.     BEQ.S    @normal
  232.  
  233. @del.handle
  234.     MOVEA.L    D0,A1                \ get address of tail
  235.     MOVE.L    (A1),-(A6)            \ put handle on stack
  236.     ADDQ.L    #1,D3                \ increment handle counter
  237.     MOVE.L    4(A1),D0            \ get pointer to next record in list
  238.     BEQ.S    @normal
  239.     BRA.S    @del.handle
  240.  
  241. @normal
  242.     MOVE.L    D3,-(A6)
  243.     JSR        EMPTY
  244.  
  245.     \ now deallocate the handles, if any
  246.     MOVE.L    (A6)+,D3
  247.  
  248. @dealloc.loop
  249.     DBRA    D3,@dealloc
  250.     BRA.S    @myexit
  251.  
  252. @dealloc
  253.     MOVE.L    (A6)+,A0
  254.             _HUnlock
  255.             _DisposHandle
  256.     BRA.S    @dealloc.loop
  257.  
  258. @myexit
  259.     RTS
  260. END-CODE
  261.  
  262. pop.VOCAB.state
  263.  
  264. pop.VOCAB.state
  265.